home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
050
/
tpstuff1.arc
/
LONGINT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-10-28
|
22KB
|
406 lines
{
Long integer arithmatic package:
This set of subroutines allow you to compute with integers in the
range of +2,147,483,647 to -2,147,483,648.
Long integers are stored as four bytes (or two words) and are defined by
the long type.
Long integers can be initialized either from a string with optionally
a sign and one to ten digits via the routine atol. The string must be
of type longstr.
Further, the routine itol allows you to initialize a long from an integer.
Finally, some DOS functions return long integers.
Long integers are converted to strings for display via the ltoa routine.
It returns a string with the type of longstr.
Performance testing indicates that these routines are typically
70% faster and require half the memory as equivilent functions
coded directly in TURBO Pascal.
See listings for calling details.
}
{; }
{; Copyright (c) 1984 Thomas J. Foth }
{; All Rights Reserved }
{; }
{; Permission is granted to freely distribute this code, but not for }
{; profit and provided that the following address and disclaimer are }
{; included. }
{; }
{; Portions of this program may be used freely, in other works, provided }
{; that credit to the author and this work appear with the portions used. }
{; }
{; The author's address: }
{; }
{; Thomas J. Foth }
{; 260 Sunset Ave. }
{; Fairfield, CT 06430 }
{; (203) 334-6401 }
{; }
{; Disclaimer: }
{; }
{; This program is provided "as-is" without warranty of any kind, either }
{; expressed or implied, including, but not limited to the implied }
{; warranties of merchantability and fitness for a particular purpose. }
{; }
type long = record
loword : integer;
hiword : integer;
end;
longstr = string[11];
procedure itol(n1:integer;var n2:long);
{ Convert signed to integer n1 to signed long n2 }
begin;
n2.loword := n1;
if n1 >= 0 then n2.hiword := 0
else n2.hiword := -1;
end;
procedure addl(var sum:long;n1,n2:long);
{ Add long n1 to n2 producing sum: may be treated as signed }
{ or unsigned }
Begin;
inline
($8B/$86/n1/ { MOV AX,n1[bp] }
$03/$86/n2/ { ADD AX,n2[bp] }
$C4/$BE/sum/ { LES DI,sum[BP] }
$26/$89/$05/ { MOV ES:[DI],AX }
$BF/$02/$00/ { MOV DI,2 }
$8B/$83/n1/ { MOV AX,n1[di+bp] }
$13/$83/n2/ { ADC AX,n2[di+bp] }
$C4/$BE/sum/ { LES DI,sum[BP] }
$26/$89/$45/$02); { MOV ES:[DI]+2,AX }
end;
procedure subl(var diff:long;n1,n2:long);
{ subtract long n2 from n1 producing diff: may be treated as signed }
{ or unsigned }
Begin;
inline
($8B/$86/n1/ { MOV AX,n1[bp] }
$2B/$86/n2/ { SUB AX,n2[bp] }
$C4/$BE/diff/ { LES DI,diff[BP] }
$26/$89/$05/ { MOV ES:[DI],AX }
$BF/$02/$00/ { MOV DI,2 }
$8B/$83/n1/ { MOV AX,n1[di+bp] }
$1B/$83/n2/ { SBB AX,n2[di+bp] }
$C4/$BE/diff/ { LES DI,diff[BP] }
$26/$89/$45/$02); { MOV ES:[DI]+2,AX }
end;
function cmpl(n1: long; op:longstr; n2:long): boolean;
{ compares long n1 with n2 returning boolean: may be treated as signed }
{ or unsigned. op is a string like '>', '<', '=>', '=<', '>=', '<=', }
{ or '='. '<>' is NOT supported: use NOT(cmpl(n1,'=',n2)) instead. }
var bool: boolean;
Begin;
inline (
$8B/$86/n1/ { MOV AX,n1[bp] }
$2B/$86/n2/ { SUB AX,n2[bp] low order word difference}
$BF/$02/$00/ { MOV DI,2 point to high order words}
$8B/$9B/n1/ { MOV BX,n1[di+bp] }
$1B/$9B/n2/ { SBB BX,n2[di+bp] high order word difference}
$30/$ED/ { XOR CH,CH }
$8A/$8E/op/ { MOV CL,op[bp] get the string length}
$8D/$B6/op/ { LEA SI,op[bp] }
$46/ { INC SI point to the first operator}
$C6/$86/bool/$00/ { MOV bool[bp],false assume false}
$E3/$36/ { jcxz exit no opeators: false}
{ tstops: }
$36/$80/$3C/$3D/ { cmp byte ptr ss:[si],'='}
$75/$0A/ { jne opt1 not an equal sign}
$09/$DB/ { or bx,bx }
$75/$22/ { jnz nxtop not zero: can't be true}
$09/$C0/ { or ax,ax }
$75/$1E/ { jnz nxtop not zero: can't be true}
$EB/$21/ { jmp true hi & lo zero: true }
{ opt1: }
$36/$80/$3C/$3E/ { cmp byte ptr ss:[si],'>'}
$75/$0C/ { jne opt2 not a greater than sign}
$09/$DB/ { or bx,bx }
$78/$12/ { js nxtop neg. difference means less than}
$75/$15/ { jnz true pos. difference means greater than}
$09/$C0/ { or ax,ax }
$75/$11/ { jnz true pos. difference means greater than}
$EB/$0A/ { jmp nxtop no difference means equal}
{ opt2: }
$36/$80/$3C/$3C/ { cmp byte ptr ss:[si],'<'}
$75/$0E/ { jne exit invalid operator is false}
$09/$DB/ { or Bx,Bx }
$78/$05/ { js true neg. difference means less than}
{ nxtop: }
$46/ { INC SI point to next operator}
$E2/$D1/ { LOOP tstops test until true or no more operators}
$EB/$05/ { JMP EXIT true not found: exit false}
{ true: }
$C6/$86/bool/$01); { MOV bool[bp],true set true}
{ exit: }
cmpl:=bool;
end;
procedure divl(var quo,rem:integer;n1:long;n2:integer);
{ Divides signed integer n2 into signed long n2, yielding signed }
{ integer quotient quo and signed integer remainder rem }
Begin;
inline
($8B/$86/n1/ { MOV AX,n1[bp] }
$BF/$02/$00/ { MOV DI,2 }
$8B/$93/n1/ { MOV DX,n1[bp+di] }
$8B/$8E/n2/ { MOV CX,n2[bp] }
$F7/$F9/ { IDIV CX }
$C4/$BE/quo/ { LES DI,quo[bp] }
$26/$89/$05/ { MOV ES:[DI],AX }
$C4/$BE/rem/ { LES DI,rem[bp] }
$26/$89/$15); { MOV ES:[DI],DX }
end;
procedure multl(var prod:long;n1,n2:integer);
{ Multiplies signed integer n2 by signed integer n2, producing signed }
{ long prod. }
Begin;
inline
($8B/$86/n1/ { MOV AX,n1[bp] }
$8B/$8E/n2/ { MOV CX,n2[bp] }
$F7/$E9/ { IMUL CX }
$C4/$BE/prod/ { LES DI,prod[bp] }
$26/$89/$05/ { MOV ES:[DI],AX }
$26/$89/$55/$02); { MOV ES:[DI+2],DX }
end;
procedure slrl(var quo:long;shift:integer);
{ Shifts quo by number of bits in 'shift' right, filling vacated bits }
{ left with zeros. }
Begin;
inline (
$cd/$02/
$8B/$8E/shift/ { MOV CX,shift[bp] }
$09/$C9/ { OR CX,CX }
$74/$18/ { JZ END }
$C4/$BE/quo/ { LES DI,quo[bp] }
$26/$8B/$05/ { MOV AX,ES:[DI] }
$26/$8B/$55/$02/ { MOV DX,ES:[DI+2] }
$D1/$EA/ { SHIFT: SHR DX }
$D1/$D8/ { RCR AX }
$E2/$FA/ { LOOP SHIFT }
$26/$89/$05/ { MOV ES:[DI],AX }
$26/$89/$55/$02); { MOV ES:[DI+2],DX }
{ END: }
end;
procedure sarl(var quo:long;shift:integer);
{ Shifts long by number fo bits in 'shift' right, propagating the sign bit.}
Begin;
inline (
$cd/$02/
$8B/$8E/shift/ { MOV CX,shift[bp] }
$09/$C9/ { OR CX,CX }
$74/$18/ { JZ END }
$C4/$BE/quo/ { LES DI,quo[bp] }
$26/$8B/$05/ { MOV AX,ES:[DI] }
$26/$8B/$55/$02/ { MOV DX,ES:[DI+2] }
$D1/$FA/ { SHIFT: SAR DX }
$D1/$D8/ { RCR AX }
$E2/$FA/ { LOOP SHIFT }
$26/$89/$05/ { MOV ES:[DI],AX }
$26/$89/$55/$02); { MOV ES:[DI+2],DX }
{ END: }
end;
procedure slll(var quo:long;shift:integer);
{ Shifts long by number fo bits in 'shift' left, filling vacated bits on }
{ right with zeros. }
Begin;
inline (
$cd/$02/
$8B/$8E/shift/ { MOV CX,shift[bp] }
$09/$C9/ { OR CX,CX }
$74/$18/ { JZ END }
$C4/$BE/quo/ { LES DI,quo[bp] }
$26/$8B/$05/ { MOV AX,ES:[DI] }
$26/$8B/$55/$02/ { MOV DX,ES:[DI+2] }
$D1/$E0/ { SHIFT: SHL AX }
$D1/$D2/ { RCL DX }
$E2/$FA/ { LOOP SHIFT }
$26/$89/$05/ { MOV ES:[DI],AX }
$26/$89/$55/$02); { MOV ES:[DI+2],DX }
{ END: }
end;
function ltoa(long:long): longstr;
{ Converts a long to signed printable ASCII string }
var temps :array[1..5] of char;
strg :longstr;
Begin;
inline(
$1E/ { PUSH DS }
$FC/ { CLD Set direction Forward }
$8C/$D0/ { MOV AX,SS }
$8E/$C0/ { MOV ES,AX }
$8E/$D8/ { MOV DS,AX }
$32/$C0/ { XOR AL,AL Clear AX }
$8D/$BE/temps/ { LEA DI,TEMPS[BP] Point to working storage }
$B9/$05/$00/ { MOV CX,5 Five bytes }
$AA/ {CLEAR: STOS BYTE PTR [DI] Clear temp variables }
$E2/$FD/ { LOOP CLEAR -all of them }
$B9/$20/$00/ { MOV CX,32 32 bits to convert }
$8B/$9E/long/ { MOV BX,LONG[BP] Load low order word }
$BF/$02/$00/ { MOV DI,2 ... and ... }
$8B/$93/long/ { MOV DX,LONG[BP+DI] hi order word }
$F7/$C2/$00/$80/ { TEST DX,$8000 Negative? }
$74/$0A/ { JZ NOCOMP Nope }
$F7/$D2/ { NOT DX 1's Complement }
$F7/$D3/ { NOT BX Both }
$83/$C3/$01/ { ADD BX,1 Add 1 }
$83/$D2/$00/ { ADC DX,0 Carry over }
$FD/ {NOCOMP: STD Set direction backward }
$51/ {BITLOOP: PUSH CX Save bit counter }
$B9/$05/$00/ { MOV CX,5 Five bytes = ten digits }
$8D/$B6/temps/ { LEA SI,TEMPS[BP] Set Indices }
$83/$C6/$04/ { ADD SI,4 -end of ws }
$8B/$FE/ { MOV DI,SI }
$D1/$E3/ { SHL BX,1 Get a Bit }
$D1/$D2/ { RCL DX,1 Rotate through all bits }
$AC/ {BITADD: LODSB Get a byte }
$12/$C0/ { ADC AL,AL Double adding in carry }
$27/ { DAA Packed adjust }
$AA/ { STOSB Save it }
$E2/$F9/ { LOOP BITADD for another two digits }
$59/ { POP CX get bit counter }
$E2/$E5/ { LOOP BITLOOP another bit }
$FC/ { CLD Go forward }
$8D/$BE/strg/ { LEA DI,strg[bp] Point to string }
$47/ { INC DI Point to character }
$33/$D2/ { XOR DX,DX Clear DX - length counter}
$BE/$02/$00/ { MOV SI,2 Offset to hi order }
$F7/$82/long/ { TEST LONG[BP+SI],8000 Negative? }
$00/$80/
$74/$04/ { JZ NOSIGNED Nope }
$42/ { INC DX Set length }
$B0/$2D/ { MOV AL,'-' Make it minus }
$AA/ { STOSB save it }
$8D/$B6/temps/ {UNSIGNED:LEA SI,TEMPS[BP] Point to working storage }
$B9/$0A/$00/ { MOV CX,10 Ten bytes }
$33/$DB/ { XOR BX,BX Clear BX - length counter}
$F7/$C1/$01/$00/ {UNPK: TEST CX,1 High order? }
$75/$0D/ { JNZ LOWNIB nope }
$AC/ { LODSB Get packed characters }
$8A/$E0/ { MOV AH,AL }
$D0/$E8/ { SHR AL,1 Hi nibble to Low nibble }
$D0/$E8/ { SHR AL,1 }
$D0/$E8/ { SHR AL,1 }
$D0/$E8/ { SHR AL,1 }
$EB/$04/ { JMP OUTSTR Go process a byte }
$8A/$C4/ {LOWNIB: MOV AL,AH Do the low nibble }
$24/$0F/ { AND AL,0FH }
$A8/$0F/ {OUTSTR: TEST AL,0FH Is this a zero }
$75/$04/ { JNZ OUTDIGIT Nope }
$09/$DB/ { OR BX,BX Have we leading nonzeroes}
$74/$04/ { JZ NXTNIB nope }
$43/ {OUTDIGIT:INC BX keep track of length }
$0C/$30/ { OR AL,'0' Make it printable }
$AA/ { STOSB save it }
$E2/$DB/ {NXTNIB: LOOP UNPK Do it again }
$01/$D3/ { ADD BX,DX Get length: is there any?}
$75/$04/ { JNZ SAVLEN Yep }
$43/ { INC BX Set length }
$B0/$30/ { MOV AL,'0' Make it zero }
$AA/ { STOSB save it }
$8D/$BE/strg/ {SAVLEN: LEA DI,strg[bp] Point to string }
$36/$88/$1D/ { MOV SS:[DI],BL Save length }
$1F); { POP DS }
ltoa:=strg; { We can't reference ltoa in inline(), so we do this. }
end;
procedure atol(strg: longstr; var val:long; var rc: integer);
begin;
inline(
{ This function mimics the Turbo val() procedure: strg is a one to }
{ 11 character string with an optional leading sign (atol accepts a }
{ leading '+' or '-' sign, val() only accepts a leading '-' sign). }
{ val is the long to receive the value. rc is 0 if the string is }
{ a null or contains a valid numeric. Else, rc is the point at which}
{ a nonnumeric was found, or the digit that caused val to overflow. }
{ like Turbo val() trailing or leading spaces are not allowed. }
{ atol accepts longs in the rangs +2,147,483,647 to -2,147,483,647. }
{ -2,147,483,648 generates an error. val() returns an error for }
{ -32,768. }
$33/$C0 {XOR AX,AX ;Clear accum }
/$33/$D2 {XOR DX,DX ; ...and ext }
/$32/$ED {XOR CH,CH ; and hi cnt }
/$33/$F6 {XOR SI,SI ; set rc if no chars }
/$8A/$8E/strg {MOV CL,[strg+BP]; get length }
/$E3/$6D {JCXZ EXIT ; return if no length }
/$8D/$BE/strg {LEA DI,[strg+bp]; point to string }
/$47 {INC DI ; point to first char }
/$BE/$FF/$FF {MOV SI,-1 ; Flag negative }
/$36/$80/$3D/$2D {CMP BYTE PTR SS:[DI],'-'; Minus sign? }
/$74/$3F {JE NXTCHR ; Make negative }
/$BE/$01/$00 {MOV SI,1 ; Assume positive }
/$36/$80/$3D/$2B {CMP BYTE PTR SS:[DI],'+'; Plus sign? }
/$74/$36 {JE NXTCHR ; go look at next char }
{CHKCHR: }
/$36/$80/$3D/$30 {CMP BYTE PTR SS:[DI],'0'; Numeric? }
/$7C/$38 {JL ENDSTR ; Nope }
/$36/$80/$3D/$39 {CMP BYTE PTR SS:[DI],'9'; }
/$7F/$32 {JG ENDSTR ; Nope }
/$BB/$0A/$00 {MOV BX,000A ; Base value }
/$50 {PUSH AX ; Save low order }
/$8B/$C2 {MOV AX,DX ; Get high order }
/$F7/$E3 {MUL BX ; Shift it }
/$70/$28 {JO ENDSTR ; Too big: error. }
/$78/$26 {JS ENDSTR }
/$8B/$D0 {MOV DX,AX ; Temp Store Hi order }
/$58 {POP AX ; Restore low order }
/$52 {PUSH DX ; Save Hi order }
/$F7/$E3 {MUL BX ; Shift low order }
/$5B {POP BX ; Get low order }
/$03/$D3 {ADD DX,BX ; Add it }
/$78/$1B {JS ENDSTR ; Too big, exit. }
/$72/$19 {JC ENDSTR }
/$36/$8A/$1D {MOV BL,BYTE PTR SS:[DI] ; Get the digit }
/$32/$FF {XOR BH,BH ; clear for add }
/$80/$EB/$30 {SUB BL,'0' ; Make binary }
/$03/$C3 {ADD AX,BX ; Add this digit }
/$83/$D2/$00 {ADC DX,0 ; Whole long }
/$78/$0A {JS ENDSTR ; Too big, exit. }
/$72/$08 {JC ENDSTR }
{NXTCHR: }
/$47 {INC DI; point to next char }
/$E2/$C7 {LOOP CHKCHR ; again }
/$33/$DB {XOR BX,BX ; No error }
/$EB/$09/$90 {JMP RETURN }
{ENDSTR: }
/$8D/$9E/strg {LEA BX,[strg+bp]; Get addr of string }
/$2B/$FB {SUB DI,BX ; Get offset to bad char }
/$8B/$DF {MOV BX,DI ; Set return code }
{RETURN: }
/$0B/$F6 {OR SI,SI ; Need to adjust sign? }
/$79/$0A {JNS RETURN1 ; nope }
/$F7/$D0 {NOT AX }
/$F7/$D2 {NOT DX }
/$83/$C0/$01 {ADD AX,1 }
/$83/$D2/$00 {ADC DX,0 ; Whole long }
{RETURN1: }
/$8B/$F3 {MOV SI,BX ; Set RC }
{EXIT: }
/$C4/$BE/rc {LES DI,DWORD PTR [BP+rc] }
/$26/$89/$35 {MOV WORD PTR ES:[DI],SI ; Set RC }
/$C4/$BE/val {LES DI,DWORD PTR [BP+val] }
/$26/$89/$05 {MOV WORD PTR ES:[DI],AX ; Low word }
/$47 {INC DI }
/$47 {INC DI }
/$26/$89/$15); {MOV WORD PTR ES:[DI],DX ; High Word }
end;
